home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
xlibpas2.zip
/
XBM2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-06-10
|
13KB
|
392 lines
{╔══════════════════════════════════════════════════════════════════════════╗
║ ║
║ XBM v2.0 for BORLAND PASCAL 7.0 ║
║ ║
╠══════════════════════════════════════════════════════════════════════════╣
║ ║
║ Original version written by ║
║ Themie Gouthas (egg@dstos3.dsto.gov.au / teg@bart.dsto.gov.au) ║
║ ║
║ Conversion to Borland Pascal by ║
║ Tristan Tarrant (tristant@cogs.susx.ac.uk) ║
║ ║
╚══════════════════════════════════════════════════════════════════════════╝}
{$A+,B-,E-,G+,I+,N-,O-,P-,Q-,S-,T-,X+}
{$IFDEF DPMI}
{$C FIXED PRELOAD PERMANENT}
{$ENDIF}
Unit Xbm2;
Interface
Uses Xlib2;
Procedure XPbmToBm( var source, dest );
Procedure XBmToPbm( var source, dest );
Procedure XPutMaskedPbm( X, Y,ScrnOffs : word; var Bitmap );
Procedure XPutPbm( X,Y,ScrnOffs:word; var Bitmap );
Procedure XGetPbm( X,Y: word;SrcWidth,SrcHeight:byte;
ScrnOffs:word; var Bitmap );
Procedure XFlipMaskedPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word );
Procedure XFlipPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word );
Procedure XCompilePbm( LogicalWidth : word; var bitmap, output );
Function XSizeOfCPbm( logicalwidth : word; var bitmap ) : word;
Procedure XCompileBitmap( logicalwidth:word; var bitmap, output );
Function XSizeOfCBitmap( logicalwidth:word; var bitmap ):word;
Procedure XPutCBitmap( XPos,YPos,PageOffset:word; var Sprite );
Procedure XPutMaskedPBMClipX( X, Y, ScrnOffs:word; var Bitmap );
procedure XPutMaskedPBMClipY( X, Y, ScrnOffs:word; var Bitmap );
Procedure XPutMaskedPBMClipXY( X, Y, ScrnOffs:word; var Bitmap );
Procedure XPutPBMClipX( X, Y, ScrnOffs:word; var Bitmap );
Procedure XPutPBMClipY( X, Y, ScrnOffs : word; var Bitmap );
Procedure XPutPBMClipXY( X, Y, ScrnOffs:word; var Bitmap );
Procedure XStoreVBMImage( VramOffs,Align:word; var LBitmap );
Procedure XPutMaskedVBM( X, Y, ScrnOffs:word; var SrcVBM );
Procedure XPutMaskedVBMClipX( X, Y, ScrnOffs:word; var SrcVBM );
Procedure XPutMaskedVBMClipY( X, Y, ScrnOffs : word; var SrcVBM );
Procedure XPutMaskedVBMClipXY( X, Y, ScrnOffs:word; var SrcVBM );
Function XMakeVBM( var lbm; var VramStart : word ) : PAlignmentHeader;
Function Xsizeofcbitmap32(logicalscreenwidth : word; var bitmapin ) : word;
Function Xcompilebitmap32(logicalscreenwidth : word; var bitmapin, bitmapout ) : word;
Procedure XScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap );
Procedure XMaskedScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap );
Implementation
{$IFDEF DPMI}
{$L XBM2.OBP}
{$ELSE}
{$L XBM2.OBJ}
{$ENDIF}
Procedure XPbmToBm( var source, dest ); external;
Procedure XBmToPbm( var source, dest ); external;
Procedure XPutMaskedPbm( X, Y,ScrnOffs : word; var Bitmap ); external;
Procedure XPutPbm( X,Y,ScrnOffs:word; var Bitmap ); external;
Procedure XGetPbm( X,Y: word;SrcWidth,SrcHeight:byte;
ScrnOffs:word; var Bitmap ); external;
Procedure XFlipMaskedPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word ); external;
Procedure XFlipPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word ); external;
Procedure XCompilePbm( LogicalWidth : word; var bitmap, output ); external;
Function XSizeOfCPbm( logicalwidth : word; var bitmap ) : word; external;
Procedure XCompileBitmap( logicalwidth:word; var bitmap, output ); external;
Function XSizeOfCBitmap( logicalwidth:word; var bitmap ):word; external;
Procedure XPutCBitmap( XPos,YPos,PageOffset:word; var Sprite ); external;
Procedure XPutMaskedPBMClipX( X, Y, ScrnOffs:word; var Bitmap ); external;
procedure XPutMaskedPBMClipY( X, Y, ScrnOffs:word; var Bitmap ); external;
Procedure XPutMaskedPBMClipXY( X, Y, ScrnOffs:word; var Bitmap ); external;
Procedure XPutPBMClipX( X, Y, ScrnOffs:word; var Bitmap ); external;
Procedure XPutPBMClipY( X, Y, ScrnOffs : word; var Bitmap ); external;
Procedure XPutPBMClipXY( X, Y, ScrnOffs:word; var Bitmap ); external;
Procedure XStoreVBMImage( VramOffs,Align:word; var LBitmap ); external;
Procedure XPutMaskedVBM( X, Y, ScrnOffs:word; var SrcVBM ); external;
Procedure XPutMaskedVBMClipX( X, Y, ScrnOffs:word; var SrcVBM ); external;
Procedure XPutMaskedVBMClipY( X, Y, ScrnOffs : word; var SrcVBM ); external;
Procedure XPutMaskedVBMClipXY( X, Y, ScrnOffs:word; var SrcVBM ); external;
Procedure XScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap ); external;
Procedure XMaskedScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap ); external;
function XMakeVBM( var lbm; var VramStart : word ) : PAlignmentHeader;
var
LBMHeadr : ^LBMheader;
VBMHeadr : PAlignmentHeader;
VBMMaskPtr, p, LBMPixelPtr : ^byte;
align,BitNum,TempImageWidth, scanline : integer;
TempWidth,TempHeight,TempSize,MaskSize,VramOffs,MaskSpace : word;
MaskTemp : byte;
begin
VramOffs := VramStart;
LBMHeadr := @lbm;
TempWidth := (LBMHeadr^.width+3) div 4+1;
TempHeight := LBMHeadr^.height;
TempSize := TempWidth*TempHeight;
getmem( VBMHeadr,22+TempSize*4);
MaskSpace:=22;
VBMHeadr^.ImageWidth := TempWidth;
VBMHeadr^.ImageHeight := TempHeight;
VBMHeadr^.size := 22+TempSize*4;
for align := 0 to 3 do
begin
VBMHeadr^.alignments[align].ImagePtr := VramOffs;
XStoreVBMImage(VramOffs,align,lbm);
MaskSpace := MaskSpace+TempSize;
VramOffs := VramOffs+TempSize;
end;
VBMMaskPtr := ptr(Seg(VBMHeadr^),Ofs(VBMHeadr^)+22);
for align:=0 to 3 do
begin
LBMPixelPtr := ptr(Seg(lbm),Ofs(lbm)+ 2);
VBMHeadr^.alignments[align].MaskPtr := Ofs(VBMMaskPtr^);
for scanline := 0 to TempHeight-1 do
begin
BitNum := align;
MaskTemp := 0;
TempImageWidth := LBMHeadr^.width;
repeat
MaskTemp := MaskTemp or (Ord(LBMPixelPtr^<>0) shl BitNum);
LBMPixelPtr := Ptr(Seg(LBMPixelPtr^),Ofs(LBMPixelPtr^)+1);
inc(BitNum);
if BitNum > 3 then
begin
VBMMaskPtr^ := MaskTemp;
VBMMaskPtr := Ptr(Seg(VBMMaskPtr^),Ofs(VBMMaskPtr^)+1);
MaskTemp := 0;
BitNum := 0;
end;
dec(TempImageWidth);
until TempImageWidth=0;
if BitNum<>0 then VBMMaskPtr^ := MaskTemp else VBMMaskPtr^ := 0;
VBMMaskPtr := Ptr(Seg(VBMMaskPtr^),Ofs(VBMMaskPtr^)+1);
end;
end;
VramStart :=VramOffs;
XMakeVBM := VBMHeadr;
end;
Const
ROLAL = $c0d0;
SHORTSTORE8 = $44c6;
STORE8 = $84c6;
SHORTSTORE16 = $44c7;
STORE16 = $84c7;
ADCSIIMMED = $d683;
OUTAL = $ee;
RETURN = $cb;
DWORDPREFIX = $66;
Function xcompilebitmap32(logicalscreenwidth : word; var bitmapin, bitmapout ) : word;
type
ByteArray = array[0..1] of byte;
var
height, column, setcolumn, scanx, scany, outputused, width, margin,
margin2, margin4, pix0, pix1, pix2, pix3, numpix : integer;
pos : integer;
bitmap : ByteArray absolute bitmapin;
output : ByteArray absolute bitmapout;
begin
column := 0;
setcolumn := 0;
scanx := 0;
scany := 0;
outputused := 0;
width := bitmap[0];
height := bitmap[1];
margin := width - 1;
margin2 := margin - 4;
margin4 := margin - 12;
while (column < 4) do
begin
numpix := 1;
pix0 := bitmap[scany*width+scanx+2];
if pix0 <> 0 then
begin
if setcolumn <> column then
begin
repeat
output[outputused]:=ROLAL and 255;
output[outputused+1]:=ROLAL shr 8;
inc(outputused,2);
output[outputused]:=ADCSIIMMED and 255;
output[outputused+1]:=ADCSIIMMED shr 8;
inc(outputused,2);
output[outputused] := 0;
inc(outputused);
inc(setcolumn);
until setcolumn = column;
output[outputused] := OUTAL;
inc(outputused);
end;
if scanx <= marg